COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	
C00007 00003	    EXTERNAL INTEGER RPGSW
C00013 00004	       LABEL NXTIME
C00017 00005	       ELSE IF CMDBRK =	"←" OR CMDBRK =	"," THEN
C00020 ENDMK
C⊗;

REQUIRE "" DELIMITERS; COMMENT TEMPORARILY OVERRIDE ANY FANCIES;
    DEFINE DSCR="COMMENT ";
    DEFINE #=" "; #
DSCR SCNCMD.SAI -- a package for scanning CUSP-like commands.

DES This package provides a function COMMAND_SCAN, and a set
 of variables and defined values with the following proerties:
PAR The following values must be DEFINEd:
  SRCMODE, LSTMODE, RELMODE the data modes for the approp. files
   (define them all, even if you don't use them)
  SRCEXT, LSTEXT, RELEXT default extension names (they should
   expand to string constants) for the appropriate files.  Blank
   will also be checked as a possible extension for source files.
  PROCESSOR should expand to a string constant.  The first three
   characters will be the name of the TMPCOR command file if started
   in RPG mode.  QQprocessor.RPG is the alternate if TMPCOR fails.
  SWTSIZ is the maximum number of switches recognized by the PROCESSOR.
  GOODSWT is a string which contains the characters which are valid
   switches.

 The following variables must be set:
  ON_ETIME should be made 0 once only, to force opening of
   the command file.
  NX_TFIL should be made 0 to force COMMAND_SCAN to expect
   a new FILE←FILE command next, instead of more source files.
  WANTBIN should be made true if a `.REL' file is to be
   opened if a file is specified for it.
  WANTLST should be made true if a `.LST' file is to be
   opened if a file is specified for it.
  SOURCECOUNT, after the call on COMMAND_SCAN, may be changed,
   either permanently or temporarily, to control input.
RES on returning from COMMAND_SCAN, the following are available:
 WANTBIN, WANTLST -- true if a file was opened in the approp.
  position, false if false coming in, or no file specified.
 BINFIL, SRCFIL -- the file, extension, and PPN for the approp.
  files (strings).
 SRC, BIN, LST, CMND, DELCHNL (1-5) are channels reserved for
  the obvious functions.  You should use these names.
 CMDTBL, LINTBL, RBRK (15-17) are break tables used by
  COMMAND_SCAN.  Use them if you wish, but don't expect
  them to be there when you get back.
 CRLF,DSCR, and BLANKS are the obvious macros.  Redefine any but DSCR
  if you wish.
SID Channels 1-5, Break Tables 15-17 are reserved by
 COMMAND_SCAN.  Do GETCHANs to obtain channels, or
 be careful.
CAL call COMMAND_SCAN with no parameters.  The first time, and
 any time subsequently that it is called with NX_TFIL=0, it
 will expect optional LST and REL specs, separated by comma,
 followed by a left arrow in the command file, then one or
 more source file names separated by commas, terminated by
 a CRLF.  Only one source file is read the first time.  Subse-
 quent calls on COMMAND_SCAN (without touching NX_TFIL) will
 cause subsequent source files to be looked up--if no more exist
 an error message will be printed.  Set this to FALSE when you
 want a brand new command.  Set ON_ETIME once for every time
 the entire program is restarted.
;
    EXTERNAL INTEGER RPGSW;
    INTEGER WANTBIN,WANTLST,SRCBRK,SRCEOF,CMDBRK,ON_ETIME,NX_TFIL;
    INTEGER SOURCECOUNT,SWTP;
    STRING BINFIL,SRCFIL,SWTSTR;
    INTEGER ARRAY SWTVAL[1:SWTSIZ];
	INTEGER ARRAY BUF[0:'377];
    DEFINE CRLF="('15&'12)", BLANKS="(""                       "")";
    DEFINE SRC="1",BIN="2",LST="3",CMND="4",DELCHNL="5";
    DEFINE LINTBL="17",	CMDTBL="16", RBRK="15";

    PROCEDURE COMMAND_SCAN;
    BEGIN "COMMAND SCAN"
       INTEGER EOF,FG,TIA,TIB,TIC,TID,SPCFIL,TIE,TIF;
       STRING CMNDFIL,LSTFIL,LINE,TSA,TSB,TSC,BKSTRNG,TSD,CMNDSTR;

	SIMPLE INTEGER PROCEDURE TMPCORSTR
	    (INTEGER CODE; STRING FIL; REFERENCE STRING TEXT);
	BEGIN COMMENT Performs TMPCOR function CODE on FIL, transfering TEXT.
		Only functions 1 (read), 2 (read and delete), 3 (write) are legal.
		Value returned is that returned in AC by the UUO, !SKIP! is
		zero if no error, else !SKIP! is -1;
	EXTERNAL INTEGER !SKIP!;
	START!CODE LABEL FOOEY,WRLUP,WRBOT,WRCLR,NOTWRITE;
	DEFINE P="'17",SP="'16",!="COMMENT";
		MOVE	1,CODE;		! CHECK VALID CODES;
		CAIL	1,1;
		CAILE	1,3;
		 JRST	FOOEY;		! YOU LOSE;
		MOVE	2,BUF;		! FWA;
		MOVEI	2,-1(2);	! FWA-1 FOR IOWD;
		HRLI	2,-'400;	! COMPLETE THE IOWD;
		PUSHJ	P,CVSIX;	! CONVERT FIL TO SIXBIT IN AC1;
		TRZ	1,-1;		! PUT ZEROES IN RIGHT HALF;
				! FILE NAME AND IOWD NOW IN 1 AND 2;
		MOVSI	5,'440700;
		HRRI	5,1(2);		! BP TO BUF;
		MOVE	3,CODE;
		MOVE	4,-1(P);! PTR TO WD2;
		CAIE	3,3;
		 MOVEM	5,(4);		! SET RESULT BP IF SOME SORT OF READ;
		CAIE	3,3;
		 JRST	NOTWRITE;
		HRRZ	3,-1(4);	! LENGTH(TEXT);
		CAILE	3,'400*5;	! CHECK MAX LENGTH;
		 JRST	FOOEY;
		MOVE	4,(4);		! COUNT IN 3, BP IN 4;
		JRST	WRBOT;
	WRLUP:	ILDB	6,4;
		IDPB	6,5;
	WRBOT:	SOJGE	3,WRLUP;
		TDZA	6,6;	! CLEAR REMAINDER OF LAST WORD;
	WRCLR:	IDPB	6,5;
		TLNE	5,'760000;
		 JRST	WRCLR;
	NOTWRITE:MOVS	3,CODE;
		HRRI	3,1;	! PARAM AC FOR TMPCOR;
		SETZM	!SKIP!;
		CALLI	3,'44;
	FOOEY:	 SETOB	3,!SKIP!;
		MOVE	1,3;
		IMULI	3,5;	! CONVERT TO CHAR COUNT;
		MOVE	2,CODE;
		MOVE	4,-1(P);! PTR TO WD 2;
		CAIE	2,3;
		 MOVEM	3,-1(4);! STORE CHAR COUNT IF SOME SORT OF READ;
		SUB	P,['3000003];
		JRST	@3(P);
	END; END;

       PROCEDURE FILENAME(REFERENCE STRING DEVICE,FILE);
       BEGIN "FILENAME"
	  PROCEDURE SWTGET;
	  BEGIN	"SWTGET"
	     SETBREAK(RBRK,"0123456789",NULL,"XA");
	     TSC←SCAN(LINE,RBRK,CMDBRK);
	     SWTVAL[SWTP←SWTP+1]←CVD(TSC[1 TO ∞-1]);
	     TID←TSC[∞ FOR 1];
	     TSD←GOODSWT;
	     FOR TIE←1 STEP 1 WHILE (TIF←LOP(TSD))∧TID≠TIF DO;
	     SWTSTR←SWTSTR&TIE;
	     IF	(CMDBRK←LINE)="/" ∨ CMDBRK=")" THEN CMDBRK←LOP(LINE)
	  END "SWTGET";
	  SPCFIL←FALSE;
	  FILE←SCAN(LINE,CMDTBL,CMDBRK)	;COMMENT GET A DEVICE OR FILENAME;
	  IF CMDBRK="["	THEN BEGIN
	     SETBREAK(RBRK,"]",NULL,"IA");
	     FILE←FILE&"["&SCAN(LINE,RBRK,CMDBRK);
	     FILE←FILE&SCAN(LINE,CMDTBL,CMDBRK)
	  END;
	  IF CMDBRK = ":" THEN BEGIN
	     DEVICE←FILE; SPCFIL←TRUE; COMMENT FILE SPECIFIED, NOT INVENTED;
	     FILE←SCAN(LINE,CMDTBL,CMDBRK)
	  END ELSE
	  IF EQU(FILE,"LPT") ∨ EQU(FILE,"LPT.")	THEN DEVICE←"LPT" ELSE
	   DEVICE←"DSK";
	  WHILE	CMDBRK="/" DO SWTGET;
	  IF CMDBRK="("	THEN BEGIN
	     DO	SWTGET UNTIL CMDBRK=")";
	     CMDBRK←LOP(LINE)
	  END;
       END "FILENAME";
       LABEL NXTIME;
       SWTP←0; SWTSTR←NULL;
       IF NX_TFIL THEN GO TO NXTIME;
       SETBREAK(CMDTBL,"←:,(!/["&'12,'15&" "&'11,"I");
       SETBREAK(LINTBL,'12,'15,"INA"); SETBREAK(RBRK,"]",NULL,"IA");
       RELEASE(BIN); RELEASE(LST);

    COMMENT FIRST GET COMMAND DEVICE;

       IF ¬RPGSW THEN OUTSTR(CRLF&"*");
       TSA← IF RPGSW THEN "DSK"	ELSE "TTY";

       IF ¬ON_ETIME THEN BEGIN
	  EOF←0;
	  COMMENT TRY TMPCOR FIRST BEFORE FILE, USE LENGTH OF CMNDSTR
		AS FLAG THAT COMMAND IS IN CMNDSTR RATHER THAN FILE;
	  CMNDSTR←NULL;
	  IF RPGSW THEN TMPCORSTR(2,PROCESSOR,CMNDSTR);
	  IF NOT(LENGTH(CMNDSTR)) THEN BEGIN
	    OPEN(CMND,TSA,0,1,1,100,CMDBRK,EOF←-1);
	    IF EOF THEN USERERR(0,0,"COMMAND DEVICE NOT AVAILABLE");
	    LOOKUP(CMND,TSB←"QQ"&PROCESSOR&".RPG",FG);
	    IF FG	THEN USERERR(0,0,"COMMAND FILE NOT FOUND");
	  END;

	  IF RPGSW AND NOT LENGTH(CMNDSTR) THEN	BEGIN "DELETE COMMAND FILE"
	     OPEN(DELCHNL,"DSK",0,2,0,100,TIA,TIA);
	     LOOKUP(DELCHNL,TSB,FG);
	     RENAME(DELCHNL,NULL,0,FG);
	     RELEASE(DELCHNL)
	  END "DELETE COMMAND FILE";

	  CMNDFIL←TSA&":"&(IF RPGSW THEN TSB ELSE NULL);
	  ON_ETIME←TRUE;
       END;
       LINE←NULL;
       WHILE ¬EOF∧(LENGTH(LINE)≤1 ∨ LENGTH(LINE)<5∧
	EQU (LINE,BLANKS[1 FOR LENGTH(LINE)-1]&'12)) DO
	 BEGIN COMMENT HANDLE TMPCOR VS. FILE;
	  IF LENGTH(CMNDSTR) THEN BEGIN
	    LINE←SCAN(CMNDSTR,LINTBL,CMDBRK);
	    EOF←NOT(LENGTH(CMNDSTR)) END
	  ELSE
	  LINE←INPUT(CMND,LINTBL); COMMENT GET RID OF BLANK LINES;
	 END;
       IF EOF THEN TIA←CALL(0,"EXIT");

       FILENAME(TSA,TSB);

       IF CMDBRK = "!" THEN BEGIN "NEW_PROGRAM"
	  INTEGER ARRAY	SWPTBL[1:5];
	  SWPTBL[1]←CVSIX(TSA);
	  SWPTBL[2]←CVFIL(TSB,SWPTBL[3],SWPTBL[5]);
	  IF ¬SPCFIL THEN SWPTBL[5]←CVSIX("  1  3");
	  IF RPGSW THEN	SWPTBL[4]←1;
	  START_CODE
	     MOVE '14,SWPTBL; MOVEM '14,TIA;
	  END;
	  CALL(TIA,"SWAP");
       END "NEW_PROGRAM"
       ELSE IF CMDBRK =	"←" OR CMDBRK =	"," THEN
	IF SPCFIL ∨ LENGTH(TSB)	THEN BEGIN "BINARY"
	   TIA←CVFIL(TSB,TIB,TIC);
	   IF TIB=0 THEN TSB←CV6STR(TIA)&"."&RELEXT;
	   TID←-1;
	   IF WANTBIN THEN BEGIN "OPNBIN"
	      OPEN(BIN,TSA,RELMODE,0,2,0,TIC,TID);
	      IF TID THEN USERERR(0,0,RELEXT&" DEVICE NOT AVAILABLE");
	      ENTER(BIN,TSB,FG);
	      IF FG THEN USERERR(0,0,"CANT ENTER "&RELEXT&" FILE");
	   END "OPNBIN";
	   BINFIL←TSA&":"&TSB;
	END "BINARY" ELSE WANTBIN←0  ELSE USERERR(0,0,PROCESSOR&
	 " COMMAND ERROR");

       IF CMDBRK = "," THEN BEGIN "LISTING"
	  FILENAME(TSA,TSB);
	  TIA←CVFIL(TSB,TIB,TIC);
	  IF TIB = 0 THEN TSB←CV6STR(TIA)&"."&LSTEXT;

	  IF WANTLST THEN BEGIN
	     OPEN(LST,TSA,LSTMODE,0,2,0,TIC,TIC);
	     ENTER(LST,TSB,FG);
	     IF	FG THEN	USERERR(0,0,"CAN'T ENTER "&LSTEXT&" FILE");
	  END;
	  LSTFIL←TSA&":"&TSB;
	  IF CMDBRK ≠ "←" THEN USERERR(0,0,PROCESSOR & " COMMAND ERROR");
       END "LISTING" ELSE WANTLST←0;
       FILENAME(TSA,TSB);
       OPEN(SRC,TSA,SRCMODE,2,0,SOURCECOUNT←200,SRCBRK,SRCEOF);

       WHILE TRUE DO BEGIN "SOURCE FILE LOOP"
	  IF CMDBRK≠'12	AND CMDBRK≠"," THEN USERERR(0,0,PROCESSOR&
	   " COMMAND ERROR");
	  CLOSE(SRC);
	  TID←CVFIL(TSB,TIC,TIE);
	  TSC←CVXSTR(TID)&"."&SRCEXT&
	   (IF TIE THEN "["&(TSC←CVXSTR(TIE))[1 FOR 3]&","&TSC[4 FOR 3]&"]"
	    ELSE NULL);
	  FG←-1;
	  IF TIC=0 THEN	LOOKUP(SRC,TSC,FG);
	  IF FG	THEN LOOKUP(SRC,TSB,FG);
	  IF FG	THEN USERERR(0,0,TSB &" FILE NOT FOUND");
	  SRCFIL←TSA&":"&TSB;
	  IF RPGSW THEN
	   OUTSTR(PROCESSOR&":	"&(IF EQU(TSA,"DSK") THEN NULL ELSE TSA)&TSB&
	    '15&'12);
	  NX_TFIL←TRUE;	  RETURN;

	  NXTIME:

	   IF CMDBRK='12  THEN USERERR(0,0,"END OF FILE ON SOURCE FILE");
	  FILENAME(TSA,TSB);
       END "SOURCE FILE LOOP";
    END	"COMMAND SCAN";

REQUIRE UNSTACK_DELIMITERS; COMMENT REVERT;